' *** FFT10.01A - Q (=2^N) POINT PFFFT (POSITIVE FREQUENCIES ONLY) ***

' THIS PROGRAM ANALYZES FINITE DOMAIN DATA WITH FRACTIONAL FREQUENCY

' ANALYSIS.  IT SIMULATES THE PREFORMANCE REQUIRED FOR A FREQUENCY

' ANALYZER AND INCLUDES THE LATEST PFFFT (FFT9_04A).

10 SCREEN 9, 1: COLOR 15, 1: CLS 'SETUP DISPLAY SCREEN

12 QX = 2 ^ 12: QI = 2 ^ 6: WSF = 1 ' MAX & NOM SIZE & SF CORR.

16 DIM C(2, QX), S(2, QX), KC(QX / 2), KS(QX / 2)'DIM MAX DATA AND TWIDDLE

18 PI = 3.141592653589793#: P2 = 2 * PI

24 IOFLG = 2: WTFLG = 1' SET TO GRAPHIC DISPLAY & NO WEIGHTING FUNCTION

26 GOTO 800 ' MAIN MENU LOCATED AT LINE 800



99  REM ***********

100 REM ** PFFFT **

101 REM ***********

102 T9 = TIMER' GET STARTING TIME

104 REM                *** STAGE A ***

106 FOR I = 0 TO Q2 - 1: I2 = 2 * I

108 C(T0, I2) = (C(T1, I) + C(T1, Q2 + I)) / 2

110 C(T0, I2 + 1) = (C(T1, I) - C(T1, Q2 + I)) / 2

112 NEXT I

114 REM                *** STAGE B ***

116 FOR I = 0 TO Q2 - 1 STEP 2: I2 = 2 * I: IQ2 = I + Q2

118 C(T1, I2) = (C(T0, I) + C(T0, IQ2)) / 2

120 C(T1, I2 + 1) = (C(T0, I + 1)) / 2: S(T1, I2 + 1) = (C(T0, IQ2 + 1)) / 2

122 C(T1, I2 + 2) = (C(T0, I) - C(T0, IQ2)) / 2

124 NEXT I

130 REM                *** REMAINING STAGES ***

132 FOR M = 2 TO N - 1: QT = 2 ^ (M - 1)' STAGE COUNTER

134 QT2 = 2 * QT: KT1 = 2 ^ (N - M - 1)

136 FOR I = 0 TO Q3 STEP QT2: I2 = 2 * I: K = I + Q2

138 REM * COMPUTE DIRECT COMPONENTS *

140 FOR J = 0 TO QT: JA = J + I: JA2 = J + I2: KT = J * KT1: KJ = K + J

142 C(T0, JA2) = (C(T1, JA) + C(T1, KJ) * KC(KT) - S(T1, KJ) * KS(KT)) / 2

144 S(T0, JA2) = (S(T1, JA) + C(T1, KJ) * KS(KT) + S(T1, KJ) * KC(KT)) / 2

146 NEXT J

150 REM * COMPUTE LATENT COMPONENTS *

152 FOR J = QT + 1 TO QT2: JA = I + QT2 - J: JA2 = J + I2: KT = J * KT1: KJ = K + QT2 - J

154 C(T0, JA2) = (C(T1, JA) + C(T1, KJ) * KC(KT) + S(T1, KJ) * KS(KT)) / 2

156 S(T0, JA2) = (-S(T1, JA) + C(T1, KJ) * KS(KT) - S(T1, KJ) * KC(KT)) / 2

158 NEXT J

160 NEXT I

162 T0 = 1 - T0: T1 = 1 - T0

164 NEXT M

166 T9 = TIMER - T9 ' GET ENDING TIME

170 ON IOFLG GOSUB 300, 350 ' DISPLAY SPECTRUM

172 RETURN



300 REM **** PRINT OUTPUT DATA ****

302 CLS : PRINT "FREQ     F(COS)       F(SIN)       "'PRINT HEADING

304 PRINT : PRINT

306 FOR Z = 0 TO Q4

308 GOSUB 320' PRINT DATA

310 LCTR = LCTR + 1: IF LCTR = 20 THEN LCTR = 0: INPUT A$ ' SCREEN FULL

312 NEXT Z

314 PRINT : PRINT "TIME ="; T9 ' EXECUTION TIME

316 LCTR = 0

318 RETURN

320 PRINT USING "###_    "; Z; ' PRINT 1ST COLUMN

322 PRINT USING "+##.#####_    "; C(T1, Z); S(T1, Z);

324 PRINT USING "###_    "; Z + Q4; ' PRINT 2ND COLUMN

326 PRINT USING "+##.#####_    "; C(T1, Z + Q4); S(T1, Z + Q4)

330 RETURN



349 REM ******  PLOT TRANSFORMED DATA  ******

350 CLS : X0 = 50: Y0 = 300: XSF = 500 / Q2: YSF = WSF * 300 * Q / QI

352 LINE (X0 - 1, 50)-(X0 - 1, Y0 + 1)' DRAW Y AXIS

354 LINE (X0, Y0 + 1)-(X0 + 500, Y0 + 1)' DRAW X AXIS

356 LINE (X0, Y0)-(X0, Y0)' SET PEN TO ORIGIN

358 FOR I = 0 TO Q2

360 YP = SQR(C(T1, I) ^ 2 + S(T1, I) ^ 2)' FIND RSS OF DATA POINT

362 LINE (X0 + XSF * I, Y0 - YSF * YP)-(X0 + XSF * I, Y0 - YSF * YP)' DRAW POINT

364 NEXT I

366 RETURN



400 REM GENERATE SINEWAVE FUNCTION

FOR I = 0 TO Q: C(T1, I) = 0: S(T1, I) = 0: NEXT I ' CLEAR ARRAYS

410 FOR I = 0 TO QDT ' GENERATE FUNCTION

412 C(T1, I) = SIN(F9 * K1 * I)

430 NEXT

440 RETURN



598 REM     *****************************

599 REM     *     SPECTRUM ANALYZER     *

600 REM     *****************************

602 CLS : PRINT : PRINT

606 PRINT "PREPARING DATA INPUT - PLEASE WAIT!"

610 T0 = 1: T1 = 0:

612 GOSUB 400' GENERATE SINUSOID

616 GOSUB 100' ANALYZE SPECTRUM

618 LOCATE 23, 20: REPT = 0' RESET REPEAT FLAG

620 PRINT : PRINT "ANY KEY TO CONTINUE: ";

622 A$ = INKEY$: IF A$ = "" THEN 622' WAIT USER INPUT

624 IF ASC(A$) = 0 THEN GOSUB 650' CURSOR HAS LEADING ZERO

626 IF REPT = 1 THEN 616' ANALYZE SPECTRUM AGAIN

628 RETURN' BACK TO MENU



650 REM HANDLE CURSOR KEYS

652 A = ASC(RIGHT$(A$, 1))' WHICH CURSOR

654 IF A < 75 OR A > 77 OR A = 76 THEN 669' NOT A CURSOR

656 IF A = 75 THEN F8 = F8 - .1' INCREMENT FREQUENCY

658 IF A = 77 THEN F8 = F8 + .1' DECREMENT FREQUENCY

660 F9 = F8 * Q / QI' SCALE FOR CURRENT FFT

662 GOSUB 400' GENERATE NEW SINUSOID

664 REPT = 1' SET REPEAT FLAG

669 RETURN' DO IT AGAIN



799 REM ************************************

800 REM ***  MAIN MENU (ANALYZER SETUP)  ***

802 REM ************************************

804 CLS : LOCATE 2, 20: PRINT "ANALYZER SETUP MENU"

806 LOCATE 6, 1 ' DISPLAY MENU

820 PRINT SPC(5); "1 = ANALYZE FULL DATA ARRAY": PRINT

822 PRINT SPC(5); "2 = ANALYZE 1/2  DATA ARRAY": PRINT

824 PRINT SPC(5); "3 = ANALYZE 1/4  DATA ARRAY": PRINT

826 PRINT SPC(5); "4 = ANALYZE 1/8  DATA ARRAY": PRINT

828 PRINT SPC(5); "5 = ANALYZE 1/16 DATA ARRAY": PRINT

830 PRINT SPC(5); "6 = CHANGE SYSTEM SETUP": PRINT

832 PRINT SPC(5); "7 = END": PRINT

834 PRINT SPC(10); "MAKE SELECTION :";

836 A$ = INKEY$: IF A$ = "" THEN 836

838 A = VAL(A$): ON A GOSUB 850, 860, 870, 880, 890, 970, 999

840 GOTO 804



850 N = 6: Q = 2 ^ (N): QDT = Q - 1' SET NEW ARRAY SIZE

852 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8

854 F8 = 16: F9 = F8 * Q / QI: K1 = P2 / Q' NEW TWIDDLES

856 FOR I = 0 TO Q2: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I): NEXT

857 GOSUB 600' ANALYZE SPECTRUM

858 RETURN' BACK TO MAIN MENU



860 N = 7: Q = 2 ^ (N): QDT = Q / 2 - 1' NEW ARRAY SIZE

862 GOTO 852



870 N = 8: Q = 2 ^ (N): QDT = Q / 4 - 1' DITTO

872 GOTO 852



880 N = 9: Q = 2 ^ (N): QDT = Q / 8 - 1' "

882 GOTO 852



890 N = 10: Q = 2 ^ (N): QDT = Q / 16 - 1' "

892 GOTO 852



970 CLS : PRINT "       SYSTEM SETUP MENU"

982 PRINT "USE GRAPHIC DISPLAY (Y/N)";

984 A$ = INKEY$: IF A$ = "" THEN 984

986 IF A$ = "Y" THEN IOFLG = 2 ELSE IOFLG = 1

998 RETURN



999 END





